home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tj50dsk1.zip / NESTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-31  |  39KB  |  1,063 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}                                       
  13.                      {       Unit:  NestTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-}       
  18.  
  19. Unit NestTTT5;
  20.  
  21. INTERFACE
  22.  
  23. Uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5;
  24.  
  25. CONST
  26.    Max_Levels = 10;        {maximum number of nested menus - alter if necessary}
  27.    MenuStrLength = 40;     {maximum length of a menu topic - alter if necessary}
  28.    DontClear    = 0;       {signal to return to same position in menu}
  29.    RefreshTopic = 1;       {signal to rewrite highlighted topic}
  30.    RefreshMenu  = 2;       {signal to reload current menu}
  31.    ClearCurrent = 3;       {signal to remove current menu}
  32.    ClearAll     = 4;       {signal to remove all menus}
  33.    Undefined    = 99;      {despatcher has not been assigned}
  34.  
  35. Type
  36.    {$IFDEF VER50}
  37.    Nest_Key_Proc =   procedure(var Ch:char; Code:Integer);
  38.    Despatcher_Proc = procedure(Var Code: integer; var Finish:byte);
  39.    {$ENDIF}
  40.  
  41.    MenuStr = string[MenuStrLength];
  42.  
  43.    N_Display = record
  44.                      X           : byte;     {top X coord}
  45.                      Y           : byte;     {top Y coord}
  46.                      LeftSide    : boolean;  {does menu start on left or right}
  47.                      AllowEsc    : boolean;  {can user escape from the top level}
  48.                      BoxType     : byte;     {single,double etc}
  49.                      BoxFCol     : byte;     {Border foreground color}
  50.                      BoxBCol     : byte;     {Border background color}
  51.                      CapFCol     : byte;     {Capital letter foreground color}
  52.                      BacCol      : byte;     {menu background color}
  53.                      NorFCol     : byte;     {normal foreground color}
  54.                      LoFCol      : byte;     {inactive topic foreground color}
  55.                      HiFCol      : byte;     {highlighted topic foreground color}
  56.                      HiBCol      : byte;     {highlighted topic background color}
  57.                      LeftChar    : char;     {left-hand topic highlight character}
  58.                      RightChar   : char;     {right-hand topic highlight character}
  59.                      {$IFDEF VER50}
  60.                      Hook        : Nest_Key_Proc;   { a procedure called after every key is pressed}
  61.                      Despatcher  : Despatcher_proc;     { the main procedure to execute}
  62.                      {$ENDIF}
  63.                end;
  64.  
  65.     TopicPtr    = ^TopicRecord;
  66.  
  67.     MenuPtr     = ^Nest_Menu;
  68.  
  69.     TopicRecord = record
  70.                         Name : MenuStr;
  71.                         Active: boolean;
  72.                         HotKey : char;
  73.                         RetCode : integer;
  74.                         Sub_Menu: MenuPtr;
  75.                         Next_Topic: TopicPtr;
  76.                    end;
  77.  
  78.     Nest_Menu  = record
  79.                         Title: MenuStr;          {title for menu}
  80.                         Topic_Width: byte;       {width of topics in menu}
  81.                         Visible_Lines : word;    {no. topics in box, 0 is DisplayLines - 2}
  82.                         First_Topic : TopicPtr;      {used internally, do not alter}
  83.                         Total_Topics: word;          {used internally, do not alter}
  84.                    end;
  85.  
  86.   VAR
  87.     {$IFNDEF VER50}
  88.     Nest_UserHook : pointer;
  89.     Nest_Despatcher: pointer;
  90.     {$ENDIF}
  91.     N_fatal : Boolean;
  92.     N_Error : Integer;
  93.     NTTT    : N_Display;
  94.  
  95.   Procedure Default_Settings;
  96.   {$IFDEF VER50}
  97.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  98.   {$ENDIF}
  99.  
  100.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  101.                                 Tit: menuStr;
  102.                                 Width: byte;
  103.                                 Display_Lines: word);
  104.  
  105.   Procedure Add_Topic(var Menu:Nest_Menu;
  106.                           Nam : MenuStr;
  107.                           Activ : boolean;
  108.                           HKey : char;
  109.                           Code : integer;
  110.                           Sub: MenuPtr);
  111.  
  112.   Procedure Modify_Topic(var Menu:Nest_Menu;
  113.                              TopicNo : word;
  114.                              Nam : MenuStr;
  115.                              Activ : boolean;
  116.                              HKey  : char;
  117.                              Code : integer;
  118.                              Sub: MenuPtr);
  119.  
  120.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  121.                                   TopicNo : word;
  122.                                   Nam : MenuStr);
  123.  
  124.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  125.                                   TopicNo : word;
  126.                                   Activ : Boolean);
  127.  
  128.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  129.                                     TopicNo : word;
  130.                                     HKey : char);
  131.  
  132.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  133.                                      TopicNo : word;
  134.                                      Code : integer);
  135.  
  136.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  137.                                      TopicNo : word;
  138.                                      Sub : MenuPtr);
  139.  
  140.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  141.  
  142.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  143.  
  144.   Procedure Show_Nest(var Menu:Nest_Menu);
  145.  
  146. IMPLEMENTATION
  147. var
  148.   Despatcher_Assigned : boolean;
  149.  
  150.   Procedure NestTTT_Error(No : byte);
  151.   {Updates N_error and optionally displays error message then halts program}
  152.   var Msg : String;
  153.   begin
  154.       N_error := No;
  155.       If N_fatal = true then
  156.       begin
  157.           Case No of
  158.           1 :  Msg := 'Insufficient memory to add topic';
  159.           2 :  Msg := 'Insufficient memory to save screen';
  160.           3 :  Msg := 'No active picks in menu';
  161.           4 :  Msg := 'Screen was not previously saved cannot restore';
  162.           5 :  Msg := 'Too many levels in menu. Change Max_Levels in NestTTT';
  163.           6 :  Msg := 'Topic does not exist, cannot modify';
  164.           7 :  Msg := 'A user procedure has not been assigned to despatcher';
  165.           else Msg := '?) -- Utterly confused';
  166.           end; {Case}
  167.           Msg := 'Fatal Error (NestTTT -- '+Msg;
  168.           Writeln(Msg);
  169.           Delay(5000);    {display long enough to read if child process}
  170.           Halt;
  171.       end;
  172.   end;
  173.  
  174. {$F+}
  175.   Procedure Empty_Despatcher(Var Code: integer; var Finish:byte);
  176.   {}
  177.   begin
  178.       Finish := Undefined;
  179.   end; {of proc Empty_Despatcher}
  180.  
  181.   Procedure No_Nest_Hook(var Ch : char; Code: Integer);
  182.   {}
  183.   begin
  184.   end; {of proc No_Nest_Hook}
  185. {$F-}
  186.  
  187.    {$IFNDEF VER50}
  188.    Procedure CallFromNestUserHook(var Ch:char; code:integer);
  189.           Inline($FF/$1E/Nest_UserHook);
  190.  
  191.    Procedure CallFromNestDespatcher(Var Code: integer; var Finish:byte);
  192.           Inline($FF/$1E/Nest_Despatcher);
  193.    {$ENDIF}
  194.  
  195.   Procedure Default_Settings;
  196.   begin
  197.       with NTTT do
  198.       begin
  199.           X := 0;
  200.           Y := 0;
  201.           Despatcher_Assigned := false;
  202.           LeftSide     := true;
  203.           AllowEsc := true;
  204.           BoxType      := 1;
  205.           If BaseOfScreen = $B800 then
  206.           begin
  207.               BoxFCol      := yellow;
  208.               BoxBCol      := blue;
  209.               CapFCol      := White;
  210.               BacCol       := blue;
  211.               NorFCol      := lightgray;
  212.               LoFCol       := black;
  213.               HiFCol       := white;
  214.               HiBCol       := red;
  215.           end
  216.           else
  217.           begin
  218.               BoxFCol      := white;
  219.               BoxBCol      := black;
  220.               CapFCol      := White;
  221.               BacCol       := black;
  222.               NorFCol      := lightgray;
  223.               LoFCol       := darkgray;
  224.               HiFCol       := white;
  225.               HiBCol       := black;
  226.           end;
  227.           LeftChar     := Chr(16);
  228.           RightChar    := Chr(17);
  229.           {$IFDEF VER50}
  230.           Hook := No_Nest_Hook;
  231.           Despatcher   := Empty_Despatcher;
  232.           {$ELSE}
  233.            Nest_UserHook := nil;
  234.            Nest_Despatcher:= nil;
  235.           {$ENDIF}
  236.       end;  {with}
  237.   end;  {Default_Settings}
  238.  
  239.   {$IFDEF VER50}
  240.   Procedure Assign_Despatcher(D:Despatcher_Proc);
  241.   begin
  242.       NTTT.Despatcher := D;
  243.       Despatcher_Assigned := true;
  244.   end;
  245.   {$ENDIF}
  246.  
  247.   Procedure Initialize_Menu(var Menu:Nest_Menu;
  248.                                 Tit: menuStr;
  249.                                 Width: byte;
  250.                                 Display_Lines: word);
  251.   {}
  252.   begin
  253.       With Menu do
  254.       begin
  255.           Title         := Tit;
  256.           Topic_Width   := Width;
  257.           Visible_Lines := Display_Lines;
  258.           First_Topic   := nil;
  259.           Total_Topics  := 0;
  260.       end; {with}
  261.   end; {of proc Initialize_Menu}
  262.  
  263.   Procedure Add_Topic(var Menu:Nest_Menu;
  264.                           Nam : MenuStr;
  265.                           Activ : boolean;
  266.                           HKey  : char;
  267.                           Code : integer;
  268.                           Sub: MenuPtr);
  269.   {Adds a new topic to the menu.}
  270.   var
  271.      TempPtr : TopicPtr;
  272.   begin
  273.       If MaxAvail < SizeOf(TempPtr^) then
  274.       begin
  275.           NestTTT_Error(1);   {not enough memory}
  276.           exit;
  277.       end
  278.       else
  279.          N_Error := 0;
  280.       If Menu.First_Topic = nil then
  281.       begin
  282.          getmem(Menu.First_Topic,SizeOf(TempPtr^));
  283.          TempPtr := Menu.First_Topic;
  284.       end
  285.       else
  286.       begin
  287.          TempPtr := Menu.First_Topic;          {start at bottom}
  288.          while TempPtr^.Next_Topic <> nil do               {loop to unallocated block}
  289.             TempPtr := TempPtr^.Next_Topic;
  290.          GetMem(TempPtr^.Next_Topic,SizeOf(TempPtr^));
  291.          TempPtr := TempPtr^.Next_Topic;
  292.       end;
  293.       with TempPtr^ do
  294.       begin
  295.           Name := Nam;
  296.           If (Name = '-') or (Name = '=') then
  297.              Active := false
  298.           else
  299.              Active := Activ;
  300.           HotKey := Hkey;
  301.           RetCode := Code;
  302.           Sub_Menu := Sub;
  303.           Next_Topic := nil;
  304.       end;
  305.       Inc(Menu.Total_Topics);
  306.   end; {of proc Add_Topic}
  307.  
  308.   Function Pointer_to_Topic(Men:Nest_Menu;TopicNo:word): TopicPtr;
  309.   {returns a pointer to the TopicNo'th entry in menu, or nil
  310.    if greater than Total_Topics}    
  311.   var    
  312.      W       : word;    
  313.      TempPtr : TopicPtr;    
  314.   begin    
  315.       with Men do
  316.       begin    
  317.           If TopicNo > Total_Topics then
  318.              TempPtr := nil
  319.           else    
  320.           begin    
  321.               TempPtr := First_Topic;    
  322.               For W := 2 to TopicNo do    
  323.                       TempPtr := TempPtr^.Next_Topic    
  324.           end;    
  325.       end;    
  326.       Pointer_to_Topic := TempPtr;    
  327.   end; {of func Pointer_to_Topic}
  328.  
  329.   Procedure Modify_Topic(var Menu:Nest_Menu;
  330.                              TopicNo : word;
  331.                              Nam : MenuStr;
  332.                              Activ : boolean;
  333.                              HKey  : char;
  334.                              Code : integer;
  335.                              Sub: MenuPtr);
  336.   {Changes all the settings for a topic}
  337.   var TempPtr : TopicPtr;
  338.   begin
  339.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  340.       If TempPtr = nil then 
  341.          NestTTT_Error(6);
  342.       With TempPtr^ do
  343.       begin
  344.           Name := Nam;
  345.           If (Name = '-') or (Name = '=') then
  346.              Active := false
  347.           else
  348.              Active := Activ;
  349.           HotKey := Hkey;
  350.           RetCode := Code;
  351.           Sub_Menu := Sub;
  352.       end; {with}
  353.   end; {of proc Modify_Topic}
  354.  
  355.   Procedure Modify_Topic_Name(var Menu:Nest_Menu;
  356.                                   TopicNo : word;
  357.                                   Nam : MenuStr);
  358.   {Change title or name of a topic}
  359.   var TempPtr : TopicPtr;
  360.   begin
  361.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  362.       If TempPtr = nil then 
  363.          NestTTT_Error(6);
  364.       TempPtr^.Name := Nam;
  365.       If (Nam = '-') or (Nam = '=') then
  366.              TempPtr^.Active := false;
  367.   end; {of proc Modify_Topic_Name}
  368.  
  369.   Procedure Modify_Topic_Active(var Menu:Nest_Menu;
  370.                                   TopicNo : word;
  371.                                   Activ : Boolean);
  372.   {Changes active status of a topic}
  373.   var TempPtr : TopicPtr;
  374.   begin
  375.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  376.       If TempPtr = nil then 
  377.          NestTTT_Error(6);
  378.       TempPtr^.Active := Activ;
  379.   end; {of proc Modify_Topic_Active}
  380.  
  381.   Procedure Modify_Topic_HotKey(var Menu:Nest_Menu;
  382.                                     TopicNo : word;
  383.                                     HKey : char);
  384.   {Changes Hotkey character of a topic}
  385.   var TempPtr : TopicPtr;
  386.   begin
  387.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  388.       If TempPtr = nil then 
  389.          NestTTT_Error(6);
  390.       TempPtr^.HotKey := HKey;
  391.   end; {of proc Modify_Topic_HotKey}
  392.  
  393.   Procedure Modify_Topic_RetCode(var Menu:Nest_Menu;
  394.                                      TopicNo : word;
  395.                                      Code : integer);
  396.   {Changes Return code for a topic}
  397.   var TempPtr : TopicPtr;
  398.   begin
  399.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  400.       If TempPtr = nil then 
  401.          NestTTT_Error(6);
  402.       TempPtr^.Retcode := Code;
  403.   end; {of proc Modify_Topic_HotKey}
  404.  
  405.   Procedure Modify_Topic_SubMenu(var Menu:Nest_Menu;
  406.                                      TopicNo : word;
  407.                                      Sub : MenuPtr);
  408.   {Changes Return code for a topic}
  409.   var TempPtr : TopicPtr;
  410.   begin
  411.       TempPtr := Pointer_To_Topic(Menu,TopicNo);
  412.       If TempPtr = nil then
  413.          NestTTT_Error(6);
  414.       TempPtr^.Sub_Menu := Sub;
  415.   end; {of proc Modify_Topic_HotKey}
  416.  
  417.   Procedure Delete_A_Topic(var Menu:Nest_Menu;TopicNo: word);
  418.   {}
  419.   var TempPtrA,TempPtrB : TopicPtr;
  420.   begin
  421.       If TopicNo = 1 then
  422.       begin
  423.           If Menu.First_Topic = nil then
  424.              NestTTT_Error(6);
  425.           TempPtrA := Menu.First_Topic^.Next_Topic;
  426.           FreeMem(Menu.First_Topic,SizeOf(TempPtrA^));
  427.           Menu.First_Topic := TempPtrA;
  428.       end
  429.       else
  430.       begin
  431.           TempPtrA := Pointer_To_Topic(Menu,pred(TopicNo));
  432.           If TempPtrA = nil then
  433.              NestTTT_Error(6);
  434.           TempPtrB := Pointer_To_Topic(Menu,TopicNo);
  435.           If TempPtrB = nil then
  436.              NestTTT_Error(6);
  437.           TempPtrA^.Next_Topic := TempPtrB^.Next_Topic;
  438.           FreeMem(TempPtrB,SizeOf(TempPtrB^));
  439.       end;
  440.       Dec(Menu.Total_Topics);
  441.   end; {of proc Delete_A_Topic}
  442.  
  443.   Procedure Delete_All_Topics(var Menu:Nest_Menu);
  444.   {}
  445.   var TempPtrA,TempPtrB : TopicPtr;
  446.   begin
  447.       TempPtrA := Menu.First_Topic;
  448.       While (TempPtrA <> nil) do
  449.       begin
  450.           TempPtrB := TempPtrA^.Next_Topic;
  451.           If TempPtrA <> nil then
  452.           begin
  453.               FreeMem(TempPtrA,SizeOf(TempPtrA^));
  454.               TempPtrA := TempPtrB;
  455.           end;
  456.       end;
  457.       Menu.First_Topic := nil;
  458.   end; {of proc Delete_All_Topics}
  459.  
  460.   Procedure Show_Nest(var Menu:Nest_Menu);
  461.   Type
  462.      LevelInfo = record
  463.                       Pick : word;
  464.                       TheMenu : MenuPtr;     {link to menu}
  465.                       X1   : integer;           {coords of saved screens}
  466.                       Y1   : integer;
  467.                       X2   : integer;
  468.                       Y2   : integer;
  469.                       TopPick : byte;
  470.                       HiPick  : byte;
  471.                       Saved_Screen: Pointer; {location of saved screen}
  472.                  end;
  473.   Var
  474.      I : word;
  475.      TempPtr : TopicPtr;
  476.      FinCode : byte;
  477.      Nest : array[1..Max_Levels] of LevelInfo;
  478.      Current_Level : byte;
  479.      LiveMenu : Nest_menu;
  480.      ChL : char;
  481.      Found,
  482.      Finished : boolean;
  483.  
  484.       Function Topic_Pointer(TopicNo:word): TopicPtr;
  485.       begin
  486.           Topic_Pointer := Pointer_to_Topic(LiveMenu,TopicNo);
  487.       end; {of func Topic_Pointer}
  488.  
  489.  
  490.       Procedure Compute_Coords(var LiveMenu:Nest_Menu);
  491.       {determines X1,Y1,X2,Y2 for new menu}
  492.       begin
  493.           With Nest[Current_level] do
  494.           begin
  495.               If LiveMenu.Visible_Lines = 0 then
  496.                  LiveMenu.Visible_Lines := DisplayLines-2;
  497.               If LiveMenu.Total_Topics < LiveMenu.Visible_Lines then
  498.                  LiveMenu.Visible_Lines := LiveMenu.Total_Topics;
  499.               If Current_Level = 1 then
  500.               begin
  501.                   If NTTT.X = 0 then
  502.                   begin
  503.                       If NTTT.LeftSide then
  504.                       begin
  505.                           X1 := 1;
  506.                           X2 := LiveMenu.Topic_Width + 4;
  507.                       end
  508.                       else    {RightSide}
  509.                       begin
  510.                           X2 := 80;
  511.                           X1 := 80 - LiveMenu.Topic_Width - 3;
  512.                       end;
  513.                   end
  514.                   else {X not Zero}
  515.                   begin
  516.                       If NTTT.LeftSide then
  517.                       begin
  518.                           X1 := NTTT.X;
  519.                           X2 := pred(X1)+LiveMenu.Topic_Width + 4;
  520.                           If X2 > 80 then
  521.                           begin
  522.                               X2 := 80;
  523.                               X1 := X2 - 3 - LiveMenu.Topic_Width;
  524.                           end;
  525.                       end
  526.                       else    {RightSide}
  527.                       begin
  528.                           X2 := NTTT.X;
  529.                           X1 := X2 - LiveMenu.Topic_Width - 3;
  530.                           If X1 < 1 then
  531.                           begin
  532.                               X1 := 1;
  533.                               X2 := X1 +LiveMenu.Topic_Width +3;
  534.                           end;
  535.                       end;
  536.                   end;
  537.                   If NTTT.Y = 0 then
  538.                      Y1 := 1
  539.                   else
  540.                      Y1 := NTTT.Y;
  541.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  542.                      Y2 := LiveMenu.Visible_Lines + 2
  543.                   else
  544.                      Y2 := LiveMenu.Total_Topics + 2;
  545.                   If Y2 > DisplayLines then
  546.                   begin
  547.                      Y2 := DisplayLines;
  548.                      LiveMenu.Visible_Lines := Y2 - succ(Y1);
  549.                   end;
  550.               end
  551.               else   {not the first level menu}
  552.               begin
  553.                   If NTTT.LeftSide then
  554.                   begin
  555.                       X1 := pred(Nest[pred(Current_Level)].X2);
  556.                       X2 := X1 + 3 + LiveMenu.Topic_Width;
  557.                       If X2 > 80 then
  558.                       begin
  559.                           X2 := 80;
  560.                           X1 := X2 - 4 - LiveMenu.Topic_Width;
  561.                       end;
  562.                   end
  563.                   else   {rightside}
  564.                   begin
  565.                       X2 := succ(Nest[pred(Current_Level)].X1);
  566.                       X1 := X2 - LiveMenu.Topic_Width - 3;
  567.                       If X1 < 1 then
  568.                       begin
  569.                           X1 := 1;
  570.                           X2 := X1 +LiveMenu.Topic_Width +3;
  571.                       end;
  572.                   end;
  573.                   Y1 := succ(Nest[Pred(Current_Level)].Y1) +
  574.                         Nest[Pred(Current_Level)].HiPick -
  575.                         Nest[Pred(Current_Level)].TopPick;
  576.                   If LiveMenu.Total_Topics >= LiveMenu.Visible_Lines then
  577.                      Y2 := succ(Y1) + LiveMenu.Visible_Lines
  578.                   else
  579.                      Y2 := succ(Y1) + LiveMenu.Total_Topics;
  580.                   If Y2 > DisplayLines then
  581.                   begin
  582.                      Y2 := DisplayLines;
  583.                      If Y2 - succ(LiveMenu.Visible_Lines) >= 1 then
  584.                         Y1 := Y2 - succ(LiveMenu.Visible_Lines)
  585.                      else
  586.                      begin
  587.                          Y1 := 1;
  588.                          LiveMenu.Visible_Lines := DisplayLines - 2;
  589.                      end;
  590.                   end;
  591.               end;
  592.           end; {With}
  593.       end; {of proc Compute_Coords}
  594.  
  595.       Procedure Save_Screen;
  596.       {saved part of screen overlayed by menu}
  597.       begin
  598.           with Nest[Current_Level] do
  599.           begin
  600.               If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  601.                   NestTTT_Error(2)
  602.               else
  603.               begin
  604.                   GetMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  605.                   PartSave(X1,Y1,X2,Y2,Saved_Screen^);
  606.               end;
  607.           end;
  608.       end; {of proc Save_Screen}
  609.  
  610.       Procedure Restore_Screen;
  611.       {saved part of screen overlayed by menu}
  612.       begin
  613.           with Nest[Current_Level] do
  614.           begin
  615.               If Saved_Screen = nil then
  616.                   NestTTT_Error(4)
  617.               else
  618.               begin
  619.                   PartRestore(X1,Y1,X2,Y2,Saved_Screen^);
  620.                   FreeMem(Saved_Screen,succ(Y2-Y1)*succ(X2-X1)*2);
  621.               end;
  622.           end;
  623.       end; {of proc Restore_Screen}
  624.  
  625.       Procedure Compute_First_Active_Pick;
  626.       {}
  627.       var I : word;
  628.       begin
  629.           With Nest[Current_level] do
  630.           begin
  631.               TopPick := 1;
  632.               HiPick := 1;
  633.               While (Topic_Pointer(HiPick)^.Active = false)
  634.               and   (HiPick < LiveMenu.Total_Topics) do
  635.                     Inc(HiPick);
  636.               If (Topic_Pointer(HiPick)^.Active = false) then {no active picks in menu}
  637.               begin
  638.                   NestTTT_Error(3);
  639.                   exit;
  640.               end;
  641.               If HiPick > LiveMenu.Visible_Lines then
  642.                  TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  643.           end; {with}
  644.       end; {of proc Compute_First_Active_Pick}
  645.  
  646.       Procedure Compute_Topic_Width(var Livemenu:Nest_Menu);
  647.       {}
  648.       var
  649.         I : word;
  650.         W,Biggest : Byte;
  651.       begin
  652.           Biggest := 0;
  653.           For I := 1 To LiveMenu.Total_Topics do
  654.           begin
  655.               W := length(Topic_Pointer(I)^.Name);
  656.               If Biggest < W then
  657.                  Biggest := W;
  658.           end;
  659.           If Biggest < length(LiveMenu.Title) then
  660.              Biggest := length(LiveMenu.Title);
  661.           LiveMenu.Topic_Width := Biggest;
  662.       end; {of proc Compute_Topic_Width}
  663.  
  664.       Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  665.       {}
  666.       var
  667.         A,Y : byte;
  668.         T : TopicPtr;
  669.       begin
  670.          T := Topic_Pointer(TopicNo);
  671.          If T = Nil then
  672.             exit;
  673.          If HiLight then
  674.             A := attr(NTTT.HiFCol,NTTT.HiBCol)
  675.          else
  676.          begin
  677.              If T^.Active then
  678.                 A := attr(NTTT.NorFcol,NTTT.BacCol)
  679.              else
  680.                 A := attr(NTTT.LoFcol,NTTT.BacCol);
  681.          end;
  682.          with Nest[Current_level] do
  683.          begin
  684.              Y := succ(Y1) + TopicNo - TopPick;
  685.              If HiLight then
  686.                 Fastwrite(succ(X1),Y,A,
  687.                           NTTT.LeftChar+
  688.                           PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  689.                           NTTT.Rightchar)
  690.              else
  691.                 Case T^.Name[1] of
  692.                 '-': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  693.                 '=': HorizLine(Succ(X1),Pred(X2),Y,NTTT.BoxFCol,NTTT.BacCol,1);
  694.                 else
  695.                     begin
  696.                         Fastwrite(succ(X1),Y,A,
  697.                                   ' '+
  698.                                   PadLeft(T^.Name,LiveMenu.Topic_Width,' ')+
  699.                                   ' ');
  700.                         If (T^.Active) and (First_Capital_Pos(T^.Name) > 0) then
  701.                            Fastwrite(succ(X1)+First_Capital_Pos(T^.Name),
  702.                                      Y,
  703.                                      attr(NTTT.CapFCol,NTTT.BacCol),
  704.                                      First_Capital(T^.Name));
  705.                     end;
  706.                 end; {Case}
  707.          end;
  708.       end; {of proc Write_Topic}
  709.  
  710.       Procedure Display_All_Topics;
  711.       {}
  712.       var I : Integer;
  713.       begin
  714.           with Nest[Current_Level] do
  715.           begin
  716.               For I := TopPick to TopPick+pred(LiveMenu.Visible_Lines) do
  717.                   Write_Topic(I,false);
  718.               Write_Topic(HiPick,true);
  719.           end;
  720.       end; {of proc Display_All_Topics}
  721.  
  722.       Procedure Display_LiveMenu;
  723.       {}
  724.       begin
  725.           with Nest[Current_Level] do
  726.           begin
  727.               FBox(X1,Y1,X2,Y2,NTTT.BoxFCol,NTTT.BoxBCol,NTTT.BoxType);
  728.               WriteBetween(X1,X2,Y1,NTTT.BoxFCol,NTTT.BoxBCol,Livemenu.Title);
  729.           end;
  730.           Display_All_Topics;
  731.       end; {of proc Display_LiveMenu}
  732.  
  733.       Function Next_Pick_Down(Wrap:boolean): word;
  734.       {}
  735.       var P : word;
  736.       begin
  737.           with Nest[Current_Level] do
  738.           begin
  739.               P := HiPick;
  740.               If P < LiveMenu.Total_Topics then
  741.               begin
  742.                   inc(P);
  743.                   while (P < LiveMenu.Total_Topics)
  744.                   and   (Topic_Pointer(P)^.Active = false) do
  745.                         Inc(P);
  746.                   If Topic_Pointer(P)^.Active = false then
  747.                   begin
  748.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  749.                       begin
  750.                          P := TopPick;  {scroll to top}
  751.                          while (P < LiveMenu.Total_Topics)
  752.                          and   (Topic_Pointer(P)^.Active = false) do
  753.                                Inc(P);
  754.                       end
  755.                       else
  756.                          P := Hipick;
  757.                   end;
  758.               end
  759.               else     {P is at bottom of menu}
  760.               begin
  761.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  762.                      P := TopPick;  {scroll to top}
  763.                   while (P < LiveMenu.Total_Topics)
  764.                   and   (Topic_Pointer(P)^.Active = false) do
  765.                         Inc(P);
  766.               end;
  767.               Next_Pick_Down := P;
  768.           end; {with}
  769.       end; {of func Next_Pick_Down}
  770.  
  771.       Function Next_Pick_Up(Wrap:boolean): word;
  772.       {}
  773.       var P : word;
  774.       begin
  775.           with Nest[Current_Level] do
  776.           begin
  777.               P := HiPick;
  778.               If P > 1 then
  779.               begin
  780.                   dec(P);
  781.                   while (P > 1)
  782.                   and   (Topic_Pointer(P)^.Active = false) do
  783.                         Dec(P);
  784.                   If Topic_Pointer(P)^.Active = false then
  785.                   begin
  786.                       If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  787.                       begin
  788.                          P := LiveMenu.Total_Topics;  {scroll to top}
  789.                          while (P > 1)
  790.                          and   (Topic_Pointer(P)^.Active = false) do
  791.                                Dec(P);
  792.                       end
  793.                       else
  794.                          P := Hipick;
  795.                   end;
  796.               end
  797.               else     {P is at top of menu}
  798.               begin
  799.                   If Wrap and (LiveMenu.Total_Topics <= LiveMenu.Visible_Lines) then
  800.                   begin
  801.                      P := LiveMenu.Total_Topics;  {scroll to top}
  802.                      while (P > 1)
  803.                      and   (Topic_Pointer(P)^.Active = false) do
  804.                            Dec(P);
  805.                   end;
  806.               end;
  807.               Next_Pick_Up := P;
  808.           end; {with}
  809.       end; {of func Next_Pick_Up}
  810.  
  811.       Procedure Load_Menu(var NewMenu:Nest_Menu);
  812.       {}
  813.       begin
  814.           If Current_Level < Max_Levels then
  815.              Inc(Current_Level)
  816.           else
  817.              NestTTT_Error(5);
  818.           Nest[Current_Level].TheMenu := @NewMenu;
  819.           LiveMenu := NewMenu;
  820.           If LiveMenu.Topic_Width <= 0 then
  821.           begin
  822.              Compute_Topic_Width(LiveMenu);
  823.              NewMenu.Topic_Width := LiveMenu.Topic_Width;
  824.           end;
  825.           Compute_Coords(LiveMenu);
  826.           Compute_Coords(NewMenu);
  827.           Compute_First_Active_Pick;
  828.           Save_Screen;
  829.           Display_LiveMenu;
  830.       end; {of proc Load_Menu;}
  831.  
  832.       Procedure Execute_Command;
  833.       {}
  834.       var
  835.          TempPtr : TopicPtr;
  836.          Code : integer;
  837.       begin
  838.           TempPtr := Topic_Pointer(Nest[Current_Level].HiPick);
  839.           If TempPtr^.Sub_Menu <> nil then
  840.              Load_Menu(TempPtr^.Sub_Menu^)
  841.           else
  842.           begin
  843.               Code := TempPtr^.Retcode;
  844.               {$IFDEF VER50}
  845.               NTTT.Despatcher(Code,Fincode);
  846.               {$ELSE}
  847.               If Nest_Despatcher <> Nil then
  848.                  CallFromNestDespatcher(Code,Fincode)
  849.               else
  850.                  Fincode := Undefined;
  851.               {$ENDIF}
  852.               Case Fincode of
  853.               Undefined    :NestTTT_Error(7);
  854.               DontClear    :;
  855.               RefreshTopic : Write_Topic(Nest[Current_Level].HiPick,True);
  856.               RefreshMenu  : Display_All_Topics;
  857.               ClearCurrent : begin
  858.                                  Restore_Screen;
  859.                                  If Current_Level > 1 then
  860.                                  begin
  861.                                     Dec(Current_Level);
  862.                                     LiveMenu := Nest[Current_Level].TheMenu^;
  863.                                  end
  864.                                  else
  865.                                     Finished := true;
  866.                              end;
  867.               ClearAll     : begin
  868.                                  While Current_Level > 0 do
  869.                                  begin
  870.                                      Restore_Screen;
  871.                                      Dec(Current_Level);
  872.                                      LiveMenu := Nest[Current_Level].TheMenu^;
  873.                                  end;
  874.                                  Finished := true;
  875.                              end;
  876.               end; {Case}
  877.           end;
  878.       end; {of proc Execute_Command}
  879.  
  880.      Procedure Display_More;
  881.      {}
  882.      var A : byte;
  883.      begin
  884.          If LiveMenu.Visible_Lines < Livemenu.Total_Topics then
  885.             with  Nest[Current_Level] do
  886.             begin
  887.                 A := attr(NTTT.CapFCol,NTTT.BoxBCol);
  888.                 If TopPick > 1 then
  889.                    Fastwrite(X2,Succ(Y1),A,chr(24))
  890.                 else
  891.                    VertLine(X2,Succ(Y1),Succ(Y1),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  892.                 If TopPick + Pred(LiveMenu.Visible_Lines) < LiveMenu.Total_Topics then
  893.                    Fastwrite(X2,Pred(Y2),A,chr(25))
  894.                 else
  895.                    VertLine(X2,Pred(Y2),Pred(Y2),NTTT.BoxFcol,NTTT.BoxBCol,Nttt.Boxtype);
  896.             end;
  897.      end; {of proc Display_More}
  898.  
  899.   begin
  900.       Current_level := 0;
  901.       {$IFDEF VER50}
  902.       If not Despatcher_Assigned then
  903.          NestTTT_Error(7);
  904.       {$ELSE}
  905.       If Nest_Despatcher = nil then
  906.          NestTTT_Error(7);
  907.       {$ENDIF}
  908.       Load_Menu(Menu);
  909.       Finished := False;
  910.       Repeat
  911.            Display_More;
  912.            ChL := GetKey;
  913.            {$IFDEF VER50}
  914.            NTTT.Hook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  915.            {$ELSE}
  916.            If Nest_UserHook <> Nil then
  917.               CallFromNestUserHook(ChL,Topic_Pointer(Nest[Current_Level].HiPick)^.RetCode);
  918.            {$ENDIF}
  919.            If ChL <> #0 then
  920.            Case upcase(ChL) of
  921.            #132,                               {right button}
  922.            #027    : If Current_Level = 1 then
  923.                      begin
  924.                          If NTTT.AllowEsc then
  925.                          begin
  926.                              Restore_Screen;
  927.                              Finished := true;
  928.                          end;
  929.                      end
  930.                      else
  931.                      begin
  932.                          Restore_Screen;
  933.                          Dec(Current_Level);
  934.                          LiveMenu := Nest[Current_Level].TheMenu^;
  935.                      end;
  936.            #133,                                       {Mouse left button}
  937.            #13     : begin                             {Enter}
  938.                          Execute_Command;
  939.                      end;
  940.            ' ',
  941.            #129,                                       {Mouse down}
  942.            #208    : with Nest[Current_Level] do       {Down arrow}
  943.                      begin
  944.                          Write_Topic(HiPick,False);
  945.                          HiPick := Next_Pick_Down(ChL = #208);
  946.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  947.                          begin
  948.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  949.                              Display_All_Topics;
  950.                          end;
  951.                          Write_Topic(HiPick,True);
  952.                      end;
  953.            #128,                                       {Mouse up}
  954.            #200    : with Nest[Current_Level] do       {Up arrow}
  955.                      begin
  956.                          Write_Topic(HiPick,False);
  957.                          HiPick := Next_Pick_Up(ChL = #200);
  958.                          If HiPick < TopPick  then
  959.                          begin
  960.                              TopPick := HiPick;
  961.                              Display_All_Topics;
  962.                          end;
  963.                          Write_Topic(HiPick,True);
  964.                      end;
  965.             #199   : If Nest[Current_Level].HiPick <> 1 then      {Home}
  966.                      begin
  967.                          Compute_First_Active_Pick;
  968.                          Display_All_Topics;
  969.                      end;
  970.             #207   : With Nest[Current_Level] do
  971.                      begin
  972.                          Write_Topic(HiPick,False);
  973.                          HiPick := LiveMenu.Total_Topics;
  974.                          While (HiPick > 0)
  975.                          and (Topic_Pointer(HiPick)^.Active =false) do
  976.                               Dec(HiPick);
  977.                          If HiPick >= TopPick + LiveMenu.Visible_Lines then
  978.                          begin
  979.                              TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  980.                              Display_All_Topics;
  981.                          end;
  982.                          Write_Topic(HiPick,True);
  983.                      end;
  984.            'A'..'Z': with Nest[Current_Level] do
  985.                      begin
  986.                          Found := false;
  987.                          I := HiPick;
  988.                          Repeat      
  989.                               TempPtr := Topic_Pointer(I);
  990.                               If  (First_Capital(TempPtr^.Name) = upcase(ChL))
  991.                               and (TempPtr^.Active) then      
  992.                               begin      
  993.                                   Found := true;
  994.                                   Write_Topic(HiPick,false);      
  995.                                   HiPick := I;
  996.                                   If HiPick >= TopPick + LiveMenu.Visible_Lines then
  997.                                   begin
  998.                                       TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  999.                                       Display_All_Topics;
  1000.                                   end
  1001.                                   else
  1002.                                      If HiPick < TopPick  then
  1003.                                      begin
  1004.                                          TopPick := HiPick;
  1005.                                          Display_All_Topics;
  1006.                                      end;
  1007.                                      Write_Topic(HiPick,true);
  1008.                               end      
  1009.                               else      
  1010.                                   If I = LiveMenu.Total_Topics then
  1011.                                      I := 1
  1012.                                   else
  1013.                                      Inc(I);
  1014.                          Until Found or (I = HiPick);
  1015.                          If Found then
  1016.                             Execute_Command;
  1017.                      end;
  1018.            else   {see if the user pressed a special key}
  1019.                with Nest[Current_Level] do
  1020.                begin
  1021.                Found := false;
  1022.                I := HiPick;
  1023.                Repeat
  1024.                     TempPtr := Topic_Pointer(I);
  1025.                     If  ((TempPtr^.Hotkey) = ChL)
  1026.                     and (TempPtr^.Active) then
  1027.                     begin
  1028.                         Found := true;
  1029.                         Write_Topic(HiPick,false);
  1030.                         HiPick := I;
  1031.                         If HiPick >= TopPick + LiveMenu.Visible_Lines then
  1032.                         begin
  1033.                             TopPick := HiPick - pred(LiveMenu.Visible_Lines);
  1034.                             Display_All_Topics;
  1035.                         end
  1036.                         else
  1037.                            If HiPick < TopPick  then
  1038.                            begin
  1039.                                TopPick := HiPick;
  1040.                                Display_All_Topics;
  1041.                            end;
  1042.                            Write_Topic(HiPick,true);
  1043.                     end
  1044.                     else
  1045.                         If I = LiveMenu.Total_Topics then
  1046.                            I := 1
  1047.                         else
  1048.                            Inc(I);
  1049.                Until Found or (I = HiPick);
  1050.                If Found then
  1051.                   Execute_Command;
  1052.                end;
  1053.       end; {case}
  1054.       Until Finished;
  1055.   end; {of proc Show_Nest}
  1056.  
  1057.  
  1058. begin
  1059.     Default_Settings;
  1060.     N_Fatal := true;
  1061. end.
  1062.  
  1063.